home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Applications / NIH Image 1.62b11 / src / RealUtils.p < prev    next >
Text File  |  1996-11-05  |  3KB  |  118 lines

  1. unit realUtils;
  2.  
  3. interface
  4.     uses
  5.         Types, Memory, QuickDraw, Packages, Menus, Events, Fonts, ToolUtils, globals, Utilities, Graphics;
  6.  
  7. function NewRealWindow (name: str255; width, height: LongInt): boolean;
  8. procedure DisplayRealImage(rData: rImagePtr; min, max: real; BlackIsZero: boolean);
  9. function ConvertToReal:boolean;
  10.  
  11.  
  12. implementation
  13.  
  14.  
  15. function NewRealWindow (name: str255; width, height: LongInt): boolean;
  16. var
  17.     TempH: handle;
  18. begin
  19.     tempH := GetBigHandle(width * height * SizeOf(real));
  20.     if TempH = nil then begin
  21.         PutMemoryAlert;
  22.         NewRealWindow := false;
  23.         exit(NewRealWindow);
  24.     end;
  25.     if not NewPicWindow(name, width, height) then begin
  26.         DisposeHandle(TempH);
  27.         exit(NewRealWindow);
  28.     end;
  29.     info^.DataH := tempH;
  30.     UpdateTitleBar;
  31.     UpdateWindowsMenuItem;
  32.     NewRealWindow := true;
  33. end;
  34.  
  35.  
  36.     procedure DisplayRealImage(rData: rImagePtr; min, max: real; BlackIsZero: boolean);
  37.         var
  38.             row, col, i, base, width, height: LongInt;
  39.             r, scale: real;
  40.             line: lineType;
  41.     begin
  42.         with info^ do begin
  43.             width := pixelsPerLine;
  44.             height := nLines;
  45.         end;
  46.         scale := 255.0 / (max - min);
  47.         for row := 0 to height - 1 do begin
  48.                 base := row * width;
  49.                 for col := 0 to width - 1 do begin
  50.                         r := rData^[base + col];
  51.                         line[col] := round((r - min) * scale);
  52.                 end;
  53.                 PutLine(0, row, width, line);
  54.             end;
  55.         if BlackIsZero then
  56.             InvertPic;
  57.         with info^ do begin
  58.             Changes := true;
  59.             fit:=StraightLine;
  60.             nCoefficients := 2;
  61.             if BlackIsZero then begin
  62.                 coefficient[1] := max;
  63.                 coefficient[2] := -1.0/scale;
  64.             end else begin
  65.                 coefficient[1] := min;
  66.                 coefficient[2] := 1.0/scale;
  67.             end;
  68.             nKnownValues := 0;
  69.             ZeroClip := false;
  70.             GenerateValues;
  71.             UnitOfMeasure := '';
  72.             UpdateTitleBar;
  73.         end;
  74.     end;
  75.     
  76.     
  77. function ConvertToReal:boolean;
  78. var
  79.     row, col, i, sum, base: LongInt;
  80.     width, height, NeededSize, CurrentSize: LongInt;
  81.     line: LineType;
  82.     rData: rImagePtr;
  83.     TempH: handle;
  84. begin
  85.     with info^ do begin
  86.         width := pixelsPerLine;
  87.         height := nLines;
  88.         NeededSize := width * height * SizeOf(real);
  89.         CurrentSize := 0;
  90.         if dataH <> nil then
  91.             CurrentSize := GetHandleSize(dataH);
  92.         if CurrentSize <> NeededSize then begin
  93.             tempH := GetBigHandle(NeededSize);
  94.             if TempH = nil then begin
  95.                 PutMemoryAlert;
  96.                 ConvertToReal := false;
  97.                 exit(ConvertToReal);
  98.             end;
  99.             dataH := tempH;
  100.         end;
  101.         hlock(dataH);
  102.         rData := rImagePtr(dataH^);
  103.     end;
  104.     for row:= 0 to height - 1 do begin
  105.         GetLine(0, row, width, line);
  106.         base := row * width;
  107.         for col := 0 to width - 1 do
  108.             rData^[base + col] := line[col];
  109.     end;
  110.     hunlock(info^.dataH);
  111.     UpdateTitleBar;
  112.     UpdateWindowsMenuItem;
  113.     ConvertToReal := true;
  114. end;
  115.  
  116.  
  117.  
  118. end. {realUtils Unit}